home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0072_MODE 13H Graphics Unit.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  8KB  |  238 lines
  1. {
  2. From: BERNIE PALLEK
  3. Subj: GRAF_13H.PAS
  4. ---------------------------------------------------------------------------
  5. }
  6. (**************************************************)
  7. (*                                                *)
  8. (*         GRAPHICS ROUTINES FOR MODE 13H         *)
  9. (*         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~         *)
  10. (*        320x200x256 (linearly-addressed)        *)
  11. (*  Collected from routines in the Public Domain  *)
  12. (*          Assembled by Bernie Pallek            *)
  13. (*                                                *)
  14. (**************************************************)
  15.  
  16. { DISCLAIMER: Use this unit at your own risk.  I will not be liable
  17.               for anything negative resulting from use of this unit. }
  18.  
  19. UNIT Graf_13h;
  20.  
  21. INTERFACE
  22.  
  23. CONST
  24.   Color : Byte = 0;
  25.  
  26. TYPE
  27.   RGBPalette = Array[0..767] of Byte;
  28.  
  29. FUNCTION  GetVideoMode : Byte;
  30. PROCEDURE SetVideoMode(desiredVideoMode : Byte);
  31. FUNCTION  GetPixel(pix2get_x, pix2get_y : Word) : Byte;
  32. PROCEDURE SetPixel(pix2set_x, pix2set_y : Word; pix2set_c : Byte);
  33. PROCEDURE Ellipse(exc, eyc, ea, eb : Integer);
  34. PROCEDURE Line(lnx1, lny1, lnx2, lny2 : Integer);
  35. PROCEDURE GetPalette(index2get : Byte; VAR r_inte, g_inte, b_inte : Byte);
  36. PROCEDURE SetPalette(index2set, r_inte, g_inte, b_inte : Byte);
  37. PROCEDURE BurstSetPalette(burstPalette : RGBPalette);
  38. PROCEDURE ScaleBitmap(VAR bmp2scale; bwidth, bheight : Byte;
  39.   bstrtx, bstrty, bendx, bendy : Word);
  40. PROCEDURE WaitForRetrace;
  41. PROCEDURE ClearScr;
  42.  
  43.  
  44. IMPLEMENTATION
  45.  
  46.  
  47. { private type used by ScaleBitmap() }
  48. TYPE
  49.   Fixed = RECORD CASE Boolean OF
  50.     True  : (w : LongInt);
  51.     False : (f, i : Word);
  52.   END;
  53.  
  54. FUNCTION GetVideoMode : Byte;
  55. VAR
  56.   tempVMode : Byte;
  57. BEGIN
  58.   ASM
  59.     mov ah,$0f
  60.     int $10
  61.     mov tempvmode,al
  62.   END;
  63.   GetVideoMode := tempVMode;
  64. END;
  65.  
  66. PROCEDURE SetVideoMode(desiredVideoMode : Byte);
  67. { desiredVideoMode = $03 : 80x25 colour text
  68.                      $13 : 320x200x256 monoplaned
  69.                            video data from $A000:0000 to $A000:FFFF
  70. }
  71. BEGIN
  72.   ASM
  73.     mov ah,0
  74.     mov al,desiredvideomode;
  75.     int $10
  76.   END;
  77. END;
  78.  
  79. FUNCTION GetPixel(pix2get_x, pix2get_y : Word) : Byte;
  80. BEGIN
  81.   GetPixel := Mem[$A000 : pix2get_y * 320 + pix2get_x];
  82. END;
  83.  
  84. PROCEDURE SetPixel(pix2set_x, pix2set_y : Word; pix2set_c : Byte);
  85. BEGIN
  86.   Mem[$A000 : pix2set_y * 320 + pix2set_x] := pix2set_c;
  87. END;
  88.  
  89. { originally by Sean Palmer, I just mangled it  :^) }
  90. PROCEDURE Ellipse(exc, eyc, ea, eb : Integer);
  91. VAR
  92.   elx, ely : Integer;
  93.   aa, aa2, bb, bb2, d, dx, dy : LongInt;
  94. BEGIN
  95.   elx := 0; ely := eb; aa := LongInt(ea) * ea; aa2 := 2 * aa;
  96.   bb := LongInt(eb) * eb; bb2 := 2 * bb;
  97.   d := bb - aa * eb + aa DIV 4; dx := 0; dy := aa2 * eb;
  98.   SetPixel(exc, eyc - ely, Color); SetPixel(exc, eyc + ely, Color);
  99.   SetPixel(exc - ea, eyc, Color); SetPixel(exc + ea, eyc, Color);
  100.  
  101.   WHILE (dx < dy) DO BEGIN
  102.     IF (d > 0) THEN BEGIN Dec(ely); Dec(dy, aa2); Dec(d, dy); END;
  103.     Inc(elx); Inc(dx, bb2); Inc(d, bb + dx);
  104.     SetPixel(exc + elx, eyc + ely, Color);
  105.     SetPixel(exc - elx, eyc + ely, Color);
  106.     SetPixel(exc + elx, eyc - ely, Color);
  107.     SetPixel(exc - elx, eyc - ely, Color);
  108.   END;
  109.   Inc(d, (3 * (aa - bb) DIV 2 - (dx + dy)) DIV 2);
  110.   WHILE (ely > 0) DO BEGIN
  111.     IF (d < 0) THEN BEGIN Inc(elx); Inc(dx, bb2); Inc(d, bb + dx); END;
  112.     Dec(ely); Dec(dy, aa2); Inc(d, aa - dy);
  113.     SetPixel(exc + elx, eyc + ely, Color);
  114.     SetPixel(exc - elx, eyc + ely, Color);
  115.     SetPixel(exc + elx, eyc - ely, Color);
  116.     SetPixel(exc - elx, eyc - ely, Color);
  117.   END;
  118. END;
  119.  
  120. { originally by Sean Palmer, I just mangled it }
  121. PROCEDURE Line(lnx1, lny1, lnx2, lny2 : Integer);
  122. VAR
  123.   lndd, lndx, lndy, lnai, lnbi, lnxi, lnyi : Integer;
  124. BEGIN
  125.   IF (lnx1 < lnx2) THEN BEGIN lnxi := 1; lndx := lnx2 - lnx1;
  126.   END ELSE BEGIN lnxi := (-1); lndx := lnx1 - lnx2; END;
  127.   IF (lny1 < lny2) THEN BEGIN lnyi := 1; lndy := lny2 - lny1;
  128.   END ELSE BEGIN lnyi := (-1); lndy := lny1 - lny2; END;
  129.   SetPixel(lnx1, lny1, Color);
  130.   IF (lndx > lndy) THEN BEGIN lnai := (lndy - lndx) * 2;
  131.     lnbi := lndy * 2;
  132.     lndd := lnbi - lndx;
  133.     REPEAT IF (lndd >= 0) THEN BEGIN Inc(lny1, lnyi);
  134.       Inc(lndd, lnai); END ELSE Inc(lndd, lnbi);
  135.       Inc(lnx1, lnxi); SetPixel(lnx1, lny1, Color);
  136.     UNTIL (lnx1 = lnx2);
  137.   END ELSE BEGIN lnai := (lndx - lndy) * 2; lnbi := lndx * 2;
  138.     lndd := lnbi - lndy;
  139.     REPEAT IF (lndd >= 0) THEN BEGIN Inc(lnx1, lnxi);
  140.       Inc(lndd, lnai); END ELSE Inc(lndd, lnbi);
  141.       Inc(lny1, lnyi); SetPixel(lnx1, lny1, Color);
  142.     UNTIL (lny1 = lny2);
  143.   END;
  144. END;
  145.  
  146. PROCEDURE GetPalette(index2get : Byte; VAR r_inte, g_inte, b_inte : Byte);
  147. { returns the r, g, and b values of a palette index }
  148. BEGIN
  149.   Port[$3C7] := index2get;
  150.   r_inte := Port[$3C9];
  151.   g_inte := Port[$3C9];
  152.   b_inte := Port[$3C9];
  153. END;
  154.  
  155. PROCEDURE SetPalette(index2set, r_inte, g_inte, b_inte : Byte);
  156. { sets the r, g, and b values of a palette index }
  157. BEGIN
  158.   Port[$3C8] := index2set;
  159.   Port[$3C9] := r_inte;
  160.   Port[$3C9] := g_inte;
  161.   Port[$3C9] := b_inte;
  162. END;
  163.  
  164. PROCEDURE BurstSetPalette(burstPalette : RGBPalette);
  165. VAR
  166.   burstCount : Word;
  167. BEGIN
  168.   Port[$3C8] := 0;
  169.   FOR burstCount := 0 TO 767 DO Port[$3C9] := burstPalette[burstCount];
  170. END;
  171.  
  172. { originally by Sean Palmer, I just mangled it }
  173. PROCEDURE ScaleBitmap(VAR bmp2scale; bwidth, bheight : Byte;
  174.   bstrtx, bstrty, bendx, bendy : Word);
  175. { - bmp2scale is an array [0..bwidth, 0..bheight] of byte      }
  176. {   which contains the original bitmap                         }
  177. { - bwidth and bheight are the actual width - 1 and the actual }
  178. {   height - 1 of the normal bitmap                            }
  179. { - bstrtx and bstrty are the x and y values for the upper-    }
  180. {   left-hand corner of the scaled bitmap                      }
  181. { - bendx and bendy are the lower-right-hand corner of the     }
  182. {   scaled version of the original bitmap                      }
  183. { - eg. to paste an unscaled version of a bitmap that is 64x64 }
  184. {   pixels in size in the top left-hand corner of the screen,  }
  185. {   fill the array with data and call:                         }
  186. {     ScaleBitmap(bitmap, 64, 64, 0, 0, 63, 63);               }
  187. { - to create an array for the bitmap, make it like this:      }
  188. {     VAR myBitmap : Array[0..bmpHeight, 0..bmpWidth] of Byte; }
  189. {   where bmpHeight is the actual height of the normal-size    }
  190. {   bitmap less one, and bmpWidth is the actual width less one }
  191. VAR
  192.   bmp_sx, bmp_sy, bmp_cy : Fixed;
  193.   bmp_s, bmp_w, bmp_h    : Word;
  194.  
  195. BEGIN
  196.   bmp_w := bendx - bstrtx + 1; bmp_h := bendy - bstrty + 1;
  197.   bmp_sx.w := bwidth * $10000 DIV bmp_w;
  198.   bmp_sy.w := bheight * $10000 DIV bmp_h;
  199.   bmp_s := 320 - bmp_w; bmp_cy.w := 0;
  200.   ASM
  201.     push ds; mov ds,word ptr bmp2scale + 2;
  202.     mov ax,$a000; mov es,ax; cld; mov ax,320;
  203.     mul bstrty; add ax,bstrtx; mov di,ax;
  204.    @l2:
  205.     mov ax,bmp_cy.i; mul bwidth; mov bx,ax;
  206.     add bx,word ptr bmp2scale;
  207.     mov cx,bmp_w; mov si,0; mov dx,bmp_sx.f;
  208.    @l:
  209.     mov al,[bx]; stosb; add si,dx; adc bx,bmp_sx.i;
  210.     loop @l;
  211.     add di,bmp_s; mov ax,bmp_sy.f; mov bx,bmp_sy.i;
  212.     add bmp_cy.f,ax; adc bmp_cy.i,bx;
  213.     dec word ptr bmp_h; jnz @l2; pop ds;
  214.   END;
  215. END;
  216.  
  217. PROCEDURE WaitForRetrace;
  218. { waits for a vertical retrace to reduce flicker }
  219. BEGIN
  220.   REPEAT UNTIL (Port[$3DA] AND 8) = 8;
  221. END;
  222.  
  223. PROCEDURE ClearScr;
  224. BEGIN
  225.   FillChar(Mem[$A000:0000], 64000, 0);
  226. END;
  227.  
  228. END.  { of unit }
  229.  
  230. That's it!  It's not complete, but it's meant as a starter for all who are
  231. interested in VGA graphics.  Happy programming!
  232.  
  233. Bernie.
  234.  
  235.  
  236. --- Maximus/2 2.01wb
  237.  * Origin: * idiot savant * +1 905 935 6628 * (1:247/128)
  238.